home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / lib / tex / uuencode.shar / uudecode.bas < prev    next >
Encoding:
BASIC Source File  |  1988-04-18  |  3.0 KB  |  115 lines
  1. # Written  1:32 am  Feb 17, 1986 by rde@ukc.ac.uk in net.sources
  2. # In Real Life: R.D.Eager at U of Kent at Canterbury, Canterbury, UK
  3. # Subject: uudecode in MS-BASIC
  4.  
  5. [food for line eater]
  6.  
  7. There  has been some discussion about public domain versions of uudecode
  8. for those souls who didn't get it in a distribution. I  thought  it  was
  9. time  to post the updated version of uudecode in Microsoft BASIC; I have
  10. made a minor change to cater for a variation in  coding  encountered  on
  11. some uuencoded files.
  12.  
  13. This  program  is  short  enough  that  it  can  be  typed in by hand if
  14. necessary. I hope it is of some  use  to  micro  owners  without  direct
  15. access to other uudecodes.
  16.  
  17. ---------CUT HERE--------CUT HERE----------CUT HERE---------CUT HERE------
  18. 1000 DEFINT A-Z
  19. 1010 REM Trap filing errors
  20. 1020 ON ERROR GOTO 1600
  21. 1030 CLS
  22. 1040 LOCATE 5,11
  23. 1050 PRINT STRING$(40," ")
  24. 1060 LOCATE 5,11
  25. 1070 INPUT "Enter name of input file: ", INFILE$
  26. 1080 OPEN INFILE$ FOR INPUT AS #1
  27. 1090 LOCATE 8,10
  28. 1100 PRINT STRING$(40," ")
  29. 1110 LOCATE 8,10
  30. 1120 INPUT "Enter name of output file: ", OUTFILE$
  31. 1130 OPEN "R", #2,OUTFILE$, 1
  32. 1140 FIELD #2, 1 AS N$
  33. 1150 REM Search for header line
  34. 1160 LINE INPUT #1,A$
  35. 1170 IF LEFT$(A$,5) <>"begin" THEN 1160
  36. 1180 LOCATE 11,10
  37. 1190 PRINT "Header = ";A$
  38. 1200 SP = ASC(" ")
  39. 1210 DIM BUF(5000)
  40. 1220 P = 0
  41. 1230 REM Main loop
  42. 1240 LINE INPUT #1, A$
  43. 1250 P = 0
  44. 1260 COUNT = ASC(LEFT$(A$,1)) - SP
  45. 1270 IF COUNT <> 64 THEN 1290
  46. 1280 COUNT = 0
  47. 1290 IF COUNT = 0 THEN 1560
  48. 1300 ADJ = COUNT MOD 4
  49. 1310 FOR I = 2 TO LEN(A$) STEP 4
  50. 1320    X1 = ASC(MID$(A$,I,I)) - SP
  51. 1330    IF X1 <> 64 THEN 1350
  52. 1340    X1 = 0
  53. 1350    X2 = ASC(MID$(A$,I+1,I+1)) - SP
  54. 1360    IF X2 <> 64 THEN 1380
  55. 1370    X2 = 0
  56. 1380    X3 = ASC(MID$(A$,I+2,I+2)) - SP
  57. 1390    IF X3 <> 64 THEN 1410
  58. 1400    X3 = 0
  59. 1410    X4 = ASC(MID$(A$,I+3,I+3)) - SP
  60. 1420    IF X4 <> 64 THEN 1440
  61. 1430    X4 = 0
  62. 1440    P = P + 1
  63. 1450    BUF(P) = (X2\16) + (X1*4)
  64. 1460    P = P + 1
  65. 1470    BUF(P) = (X3\4) + ((X2 MOD 16) * 16)
  66. 1480    P = P + 1
  67. 1490    BUF(P) = X4 + ((X3 MOD 4) * 64)
  68. 1500 NEXT I
  69. 1510 FOR I = 1 TO P
  70. 1520   LSET N$ = CHR$(BUF(I))
  71. 1530   PUT #2
  72. 1540 NEXT I
  73. 1550 GOTO 1240
  74. 1560 END
  75. 1570 REM
  76. 1580 REM Error trapping routine for file handling
  77. 1590 REM
  78. 1600 IF ERL <> 1080 GOTO 1650          ' not input file problem
  79. 1610 LOCATE 22,20
  80. 1620 PRINT "Can't open input file"
  81. 1630 GOSUB 1780
  82. 1640 RESUME 1040
  83. 1650 IF ERL <> 1130 GOTO 1700          ' not output file problem
  84. 1660 LOCATE 22,20
  85. 1670 PRINT "Can't open output file"
  86. 1680 GOSUB 1780
  87. 1690 RESUME 1090
  88. 1700 IF ERL <> 1160 THEN 1770
  89. 1710 LOCATE 22,20
  90. 1720 PRINT "Header line not found"
  91. 1730 GOSUB 1780
  92. 1740 GOSUB 1780
  93. 1750 LOCATE 24,1
  94. 1760 END
  95. 1770 ERROR ERR
  96. 1780 FOR I = 1 TO 5000: NEXT I
  97. 1790 LOCATE 22,20
  98. 1800 PRINT STRING$(30," ")
  99. 1810 RETURN
  100. TE 24,1
  101. 1760 END
  102. 1770 ERROR ERR
  103. 1780 FOR I = 1 TO 5000: NEXT I
  104. 1
  105. ---------CUT HERE--------CUT HERE----------CUT HERE---------CUT HERE------
  106. -- 
  107.            Bob Eager
  108.  
  109.            rde@ukc.UUCP
  110.            rde@ukc
  111.            ...!mcvax!ukc!rde
  112.  
  113.            Phone: +44 227 66822 ext 7589
  114. # End of text from net.sources on hplabsc.UUCP
  115.